SetOptions[$FrontEndSession,NotebookAutoSave->True]
NotebookSave[]

SetOptions[$FrontEndSession,EvaluationCompletionAction->"ShowTiming"]

Large-color R-matrix and positive braid knots

This Mathematica file illustrates the state sum model based on large-color R-matrix developed in arXiv:2004.02087.  
Evaluate the initialization cells before use.

Initialization (q-binomial coefficients and R-matrices)

$Assumptions=q>0&&x>0&&y>0&&z>0&&t>0

QBin[n_,k_,q_]:=Which[k≥0,Product[((1-(q^(n-l+1)))/(1-(q^l))),{l,1,k}],n-k≥0,Product[((1-(q^(n-l+1)))/(1-(q^l))),{l,1,n-k}],True,0]

R[i_,j_,i2_,j2_,q_,x_]:=If[i+j==i2+j2,If[i2≥j,((q^((j+j2+1)/2))/(x^((j+j2+1)/2)))(q^(j j2))QBin[i,j2,q]Product[1-(q^(j+l))(x^(-1)),{l,1,i2-j}],((q^((j+j2+1)/2))/(x^((j+j2+1)/2)))(q^(j j2))((QBin[i,j2,q])/(Product[1-(q^(j-l))(x^(-1)),{l,0,j-i2-1}]))],0]

Rinv[i_,j_,i2_,j2_,q_,x_]:=If[i+j==i2+j2,If[j2≥i,((x^((i+i2+1)/2))/(q^((i+i2+1)/2)))(q^(-i i2))QBin[j,i2,(q^(-1))]Product[1-(q^(-i-l))x,{l,1,j2-i}],((x^((i+i2+1)/2))/(q^((i+i2+1)/2)))(q^(-i i2))((QBin[j,i2,(q^(-1))])/(Product[1-(q^(-i+l))x,{l,0,i-j2-1}]))],0]

For the R-matrix for two differently colored strands, we use the one such that the leftover term is (q^(nm/4)) instead of (q^((nm-1)/4)).

Rxy[i_,j_,i2_,j2_,q_,x_,y_]:=If[i+j==i2+j2,If[i2≥j,((q^((j+j2+(1/2))/2))/((x^((i2+j+1)/4))(y^((3j2-i+1)/4))))(q^(j j2))QBin[i,j2,q]Product[1-(q^(j+l))(y^(-1)),{l,1,i2-j}],((q^((j+j2+(1/2))/2))/((x^((i2+j+1)/4))(y^((3j2-i+1)/4))))(q^(j j2))((QBin[i,j2,q])/(Product[1-(q^(j-l))(y^(-1)),{l,0,j-i2-1}]))],0]

Rxyinv[i_,j_,i2_,j2_,q_,x_,y_]:=If[i+j==i2+j2,If[j2≥i,(((x^((3i2-j+1)/4))(y^((j2+i+1)/4)))/(q^((i+i2+(1/2))/2)))(q^(-i i2))QBin[j,i2,(q^(-1))]Product[1-(q^(-i-l))x,{l,1,j2-i}],(((x^((3i2-j+1)/4))(y^((j2+i+1)/4)))/(q^((i+i2+(1/2))/2)))(q^(-i i2))((QBin[j,i2,(q^(-1))])/(Product[1-(q^(-i+l))x,{l,0,i-j2-1}]))],0]

Invariance under positive stabilization

Positive stabilization

Do[Series[Sum[R[w,m,w,m,q,x](x^(1/2)) (q^(-(1/2)-m)),{m,0,w}],{x,∞,10}]//Simplify//Normal//Print,{w,0,5}]

Torus knot examples

For torus knots, a formula for the two-variable series was given in Theorem 1.3 of Gukov-Manolescu (arXiv:1904.06057), derived from the plumbing description. 
Here, we use the large-color R-matrix to get the same results.

(Subscript[3, 1]) = T(2,3)

Take the braid ((Subscript[σ, 1])^3)

Series[((x^(1/2))-(x^(-1/2)))Sum[R[0,m,m,0,q,x]R[m,0,m,0,q,x]R[m,0,0,m,q,x](x^(1/2)) (q^(-(1/2)-m)),{m,0,10}],{x,∞,10}]//Simplify
Do[-Coefficient[%,x,((-1)/2)-j]//Print,{j,0,10}]

In the classical q=1 limit, this becomes

Series[(((x^(1/2))-(x^(-1/2)))/(x-1+(x^(-1)))),{x,∞,10}]

(Subscript[5, 1]) = T(2,5)

Take the braid ((Subscript[σ, 1])^5)

Series[((x^(1/2))-(x^(-1/2)))Sum[R[0,a,a,0,q,x]R[a,0,a-b,b,q,x]R[a-b,b,a-c,c,q,x]R[a-c,c,a,0,q,x]R[a,0,0,a,q,x](x^(1/2)) (q^(-(1/2)-a)),{a,0,10},{b,0,a},{c,0,a-b}],{x,∞,10}]//Simplify
Do[-Coefficient[%,x,((-1)/2)-j]//Print,{j,0,10}]

In the classical q=1 limit, this becomes

Series[(((x^(1/2))-(x^(-1/2)))/((x^2)-x+1-(x^(-1))+(x^(-2)))),{x,∞,10}]

(Subscript[8, 19])=T(3,4)

Take the braid ((Subscript[σ, 1])^3)(Subscript[σ, 2])((Subscript[σ, 1])^3)(Subscript[σ, 2])

With[{cutoff=7},Series[((x^(1/2))-(x^(-1/2)))Sum[R[0,a,a,0,q,x]R[a,0,a-c,c,q,x]R[a-c,c,a-d,d,q,x]R[d,b,b+d-e,e,q,x]R[a-d,b+d-e,a+b-e-f,f,q,x]R[a+b-e-f,f,a+b-e,0,q,x]R[a+b-e,0,0,a+b-e,q,x]R[a+b-e,e,a,b,q,x](x^(2/2)) (q^(-(2/2)-a-b)),{a,0,cutoff},{b,0,cutoff},{c,0,a},{d,0,a-c},{e,0,d},{f,0,a-d}],{x,∞,10}]//Simplify]
Do[-Coefficient[%,x,((-1)/2)-j]//Print,{j,0,10}]

In the classical q=1 limit, this becomes

Series[(((x^(1/2))-(x^(-1/2)))/((x^3)-(x^2)+1-(x^(-2))+(x^(-3)))),{x,∞,10}]

Torus link examples

L4a1 = T(2,4)

Take the braid ((Subscript[σ, 1])^4). 
Below, t is an expansion parameter and should be set to 1 eventually.

With[{cutoff=8},(((((t x))^(1/2))-(((t x))^(-1/2)))Series[Sum[Rxy[0,a,a,0,q,t x,t y]Rxy[a,0,a-b,b,q,t y,t x]Rxy[a-b,b,a,0,q,t x,t y]Rxy[a,0,0,a,q,t y,t x](((t y))^(1/2))(q^(-(1/2)-a)),{a,0,cutoff},{b,0,a}],{t,∞,10}]//Simplify)]

In the classical q=1 limit, this becomes the inverse Alexander-Conway polynomial

Series[(1/(t (x^(1/2))(y^(1/2))-(t^(-1))(x^(-1/2))(y^(-1/2)))),{t,∞,10}]//Simplify

Non-torus positive braid knots

(Subscript[10, 139])

Take the braid ((Subscript[σ, 1])^4)(Subscript[σ, 2])((Subscript[σ, 1])^3)((Subscript[σ, 2])^2)

With[{cutoff=6},Series[((x^(1/2))-(x^(-1/2)))Sum[R[0,a,a,0,q,x]R[a,0,a-c,c,q,x]R[a-c,c,a-d,d,q,x]R[a-d,d,a-e,e,q,x]R[e,b,b+e-f,f,q,x]R[a-e,b+e-f,a+b-f-g,g,q,x]R[a+b-f-g,g,a+b-f,0,q,x]R[a+b-f,0,0,a+b-f,q,x]R[a+b-f,f,a+b-h,h,q,x]R[a+b-h,h,a,b,q,x](x^(2/2)) (q^(-(2/2)-a-b)),{a,0,cutoff},{b,0,cutoff},{c,0,a},{d,0,a-c},{e,0,a-d},{f,0,e},{g,0,a-e},{h,0,a+b-f}],{x,∞,10}]//Simplify]
Do[-Coefficient[%,x,((-1)/2)-j]//Print,{j,0,10}]

In the classical q=1 limit, this becomes

Series[(((x^(1/2))-(x^(-1/2)))/((x^4)-(x^3)+2x-3+2(x^(-1))-(x^(-3))+(x^(-4)))),{x,∞,10}]

(Subscript[10, 152])

Take the braid ((Subscript[σ, 1])^3)((Subscript[σ, 2])^2)((Subscript[σ, 1])^2)((Subscript[σ, 2])^3)

With[{cutoff=6},Series[((x^(1/2))-(x^(-1/2)))Sum[R[0,a,a,0,q,x]R[a,0,a-c,c,q,x]R[a-c,c,a-d,d,q,x]R[d,b,b+d-e,e,q,x]R[b+d-e,e,b+d-f,f,q,x]R[a-d,b+d-f,a+b-f,0,q,x]R[a+b-f,0,0,a+b-f,q,x]R[a+b-f,f,a+b-g,g,q,x]R[a+b-g,g,a+b-h,h,q,x]R[a+b-h,h,a,b,q,x](x^(2/2)) (q^(-(2/2)-a-b)),{a,0,cutoff},{b,0,cutoff},{c,0,a},{d,0,a-c},{e,0,d},{f,0,b+d-e},{g,0,a+b-f},{h,0,a+b-g}],{x,∞,10}]//Simplify]
Do[-Coefficient[%,x,((-1)/2)-j]//Print,{j,0,10}]

In the classical q=1 limit, this becomes

Series[(((x^(1/2))-(x^(-1/2)))/((x^4)-(x^3)-(x^2)+4x-5+4(x^(-1))-(x^(-2))-(x^(-3))+(x^(-4)))),{x,∞,10}]

Strange identities

Kontsevich-Zagier strange identity is an “identity” between the perturbative series for Kashaev invariants (defined at roots of unity) for (Subscript[3, 1]) and that of a q-series (∂/(∂x))(SuperMinus[(Subscript[F, (Subscript[3, 1])])])(x,q)(Subscript[|, x=1]) (defined inside the unit disk |q|<1). 
Here, we compute the q-series ((((Subscript[F, K])^±)(x,q))/((x^(1/2))-(x^(-1/2))))(Subscript[|, x=1]) = (∂/(∂x))(SuperMinus[(Subscript[F, K])])(x,q)(Subscript[|, x=1]) for some positive braid knots.

(Subscript[3, 1]) (the q-series for Kontsevich-Zagier strange identity)

Series[((x^(1/2))-(x^(-1/2)))Sum[R[0,m,m,0,q,x]R[m,0,m,0,q,x]R[m,0,0,m,q,x](x^(1/2)) (q^(-(1/2)-m)),{m,0,10}],{x,∞,10}]//Simplify
Sum[-Coefficient[%,x,((-1)/2)-j]*((2j+1)/2),{j,0,10}]

This last q-series is the one appearing in Kontsevich-Zagier strange identity.

(Subscript[5, 1])

With[{cutoff=15},Series[((x^(1/2))-(x^(-1/2)))Sum[R[0,a,a,0,q,x]R[a,0,a-b,b,q,x]R[a-b,b,a-c,c,q,x]R[a-c,c,a,0,q,x]R[a,0,0,a,q,x](x^(1/2)) (q^(-(1/2)-a)),{a,0,cutoff},{b,0,a},{c,0,a-b}],{x,∞,15}]//Simplify]
Sum[-Coefficient[%,x,((-1)/2)-j]*((2j+1)/2),{j,0,15}]

(Subscript[10, 139])

Increase the cutoff to get more terms

With[{cutoff=6},Series[((x^(1/2))-(x^(-1/2)))Sum[R[0,a,a,0,q,x]R[a,0,a-c,c,q,x]R[a-c,c,a-d,d,q,x]R[a-d,d,a-e,e,q,x]R[e,b,b+e-f,f,q,x]R[a-e,b+e-f,a+b-f-g,g,q,x]R[a+b-f-g,g,a+b-f,0,q,x]R[a+b-f,0,0,a+b-f,q,x]R[a+b-f,f,a+b-h,h,q,x]R[a+b-h,h,a,b,q,x](x^(2/2)) (q^(-(2/2)-a-b)),{a,0,cutoff},{b,0,cutoff},{c,0,a},{d,0,a-c},{e,0,a-d},{f,0,e},{g,0,a-e},{h,0,a+b-f}],{x,∞,4+cutoff}]//Simplify]
Sum[-Coefficient[%,x,((-1)/2)-j]*((2j+1)/2),{j,0,15}]//Expand

With[{cutoff=7},Series[((x^(1/2))-(x^(-1/2)))Sum[R[0,a,a,0,q,x]R[a,0,a-c,c,q,x]R[a-c,c,a-d,d,q,x]R[a-d,d,a-e,e,q,x]R[e,b,b+e-f,f,q,x]R[a-e,b+e-f,a+b-f-g,g,q,x]R[a+b-f-g,g,a+b-f,0,q,x]R[a+b-f,0,0,a+b-f,q,x]R[a+b-f,f,a+b-h,h,q,x]R[a+b-h,h,a,b,q,x](x^(2/2)) (q^(-(2/2)-a-b)),{a,0,cutoff},{b,0,cutoff},{c,0,a},{d,0,a-c},{e,0,a-d},{f,0,e},{g,0,a-e},{h,0,a+b-f}],{x,∞,4+cutoff}]//Simplify]
Sum[-Coefficient[%,x,((-1)/2)-j]*((2j+1)/2),{j,0,15}]//Expand